home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / MARYLAND / P5-1992.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-04  |  4KB  |  216 lines
  1. program problem5at1992;
  2. {$R-}
  3. type
  4.    timetype=record
  5.       original:string;
  6.       weight:longint;
  7.       hh:byte;
  8.       mm:byte;
  9.       ss:byte;
  10.    end;
  11.    datetype=record
  12.       original:string;
  13.       year:word;
  14.       years:string[5];
  15.       month:byte;
  16.       day:byte;
  17.    end;
  18.    appointmenttype=record
  19.       time:timetype;
  20.       date:datetype;
  21.       original:string[100];
  22.    end;
  23. procedure capitalize(var streng:string);
  24. var
  25.    a:integer;
  26. begin
  27.    for a:=1 to length(streng) do
  28.       streng[a]:=upcase(streng[a]);
  29. end;
  30.  
  31. procedure increte(var streng:string);
  32. const
  33.    needed=['P','M','N','A','0'..'9','/',':',' '];
  34. var
  35.    a:integer;
  36. begin
  37.    a:=0;
  38.    repeat
  39.       inc(a);
  40.       if not(streng[a] in needed) then
  41.       begin
  42.          delete(streng,a,1);
  43.          dec(a);
  44.       end;
  45.    until a=length(streng);
  46. end;
  47.  
  48. procedure sink(var streng:string;  position:integer);
  49. const
  50.    sinkable=['A'..'Z',' '];
  51. var
  52.    a:integer;
  53. begin
  54.    if position>0 then
  55.       for a:=position+1 downto position-1 do
  56.          if streng[a] in sinkable then delete(streng,a,1);
  57. end;
  58.  
  59. procedure move(var streng1,streng2:string; start,finish:integer);
  60. var
  61.    a:integer;
  62. begin
  63.    for a:=start to finish do
  64.       streng2:=concat(streng2,streng1[a]);
  65.    delete(streng1,start,finish-start+1);
  66. end;
  67.  
  68. procedure center(var streng:string);
  69. const
  70.    number=['0'..'9'];
  71. var
  72.    temps:string;
  73.    a:integer;
  74. begin
  75.    temps:='';
  76.    sink(streng,pos('A',streng)-2);
  77.    sink(streng,pos('P',streng)-2);
  78.    sink(streng,pos(':',streng));
  79.    move(streng,temps,1,pos(':',streng)+1);
  80.    sink(streng,pos(':',streng));
  81.    move(streng,temps,1,pos(':',streng)+1);
  82.    sink(streng,pos('/',streng));
  83.    move(streng,temps,1,pos('/',streng)+1);
  84.    sink(streng,pos('/',streng));
  85.    move(streng,temps,1,pos('/',streng)+1);
  86.    repeat
  87.       a:=length(streng);
  88.       sink(streng,a);
  89.    until streng[a] in number;
  90.    streng:=concat(temps,streng);
  91. end;
  92.  
  93. procedure devide(temps:string;  var streng1,streng2:string);
  94. begin
  95.    move(temps,streng1,1,pos(' ',temps)-1);
  96.    sink(temps,1);
  97.    streng2:=temps;
  98. end;
  99.  
  100. procedure clear(var appointment:appointmenttype);
  101. begin
  102.    with appointment do
  103.    begin
  104.       original:='';
  105.       with time do
  106.       begin
  107.          original:='';
  108.          weight:=0;
  109.          hh:=0;
  110.          mm:=0;
  111.          ss:=0;
  112.       end;
  113.       with date do
  114.       begin
  115.          original:='';
  116.          year:=0;
  117.          years:='';
  118.          month:=0;
  119.          day:=0;
  120.       end;
  121.    end;
  122. end;
  123.  
  124. procedure desifertime12(var time:timetype);
  125. var
  126.    temps,temphh,tempmm,tempss:string;
  127. begin
  128.    temps:=time.original;
  129.    move(temps,temphh,1,pos(':',temps)-1);
  130.    del(temps,pos(':',temps),1);
  131.    if pos(':',temps)=0 then tempmm:=temps
  132.    else begin
  133.       move(temps,tempmm,1,pos(':',temps)-1);
  134.       del(temps,pos(':',temps),1);
  135.       if length(temps)>0 then tempss:=temps;
  136.    end;
  137.    temphh:=value(temphh);
  138.    tempmm:=value(tempmm);
  139.    tempss:=value(tempss);
  140. end;
  141.  
  142. procedure desifertime(var time:timetype);
  143. var
  144.    temps,temphh,tempmm,tempss:string;
  145. begin
  146.    temps:=time.original;
  147.    if pos('M',temps)+pos('N',temps)=0 then
  148.    begin
  149.       move(temps,temphh,1,pos(':',temps)-1);
  150.       del(temps,pos(':',temps),1);
  151.       if pos(':',temps)=0 then tempmm:=temps
  152.       else begin
  153.          move(temps,tempmm,1,pos(':',temps)-1);
  154.          del(temps,pos(':',temps),1);
  155.          if length(temps)>0 then tempss:=temps;
  156.       end;
  157.       time.hh:=value(temphh);
  158.       time.mm:=value(tempmm);
  159.       time.ss:=value(tempss);
  160.    end
  161.    else desifertime12(time);
  162. end;
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185. procedure splice(var appointment:appointmenttype);
  186. var
  187.    temps:string;
  188. begin
  189.    temps:=appointment.original;
  190.    capitalize(temps);
  191.    increte(temps);
  192.    center(temps);
  193.    devide(temps,appointment.time.original,appointment.date.original);
  194. end;
  195.  
  196. procedure control;
  197. var
  198.    batchfile:text;
  199.    tempr:appointmenttype;
  200. begin
  201.    assign(batchfile,'a:p5-data.dat');
  202.    reset(batchfile);
  203.    writeln;
  204.    writeln;
  205.  repeat
  206.    clear(tempr);
  207.    readln(batchfile,tempr.original);
  208.    splice(tempr);
  209.    write(tempr.time.original,' ',tempr.date.original);
  210.    readln;
  211.  until eof(batchfile);
  212. end;
  213.  
  214. begin
  215.    control;
  216. end.